Group Predictions

Row

Win percentage for the week

Season Win Percentage

Games Correct

186

Games Picked

277

Number of predictions

10

Row

This Week’s Predictions
Game Prediction Winner Correct Correct Votes Correct Percent
1 Seattle Seahawks Seattle Seahawks Yes 10 1

Individual Predictions

row

Individual Table

Individual Results
Week 22
Name
Weekly # Correct
Percent Weeks Picked Season Percent Adj Season Percent Season Trend
Week 1 Week 2 Week 3 Week 4 Week 5 Week 6 Week 7 Week 8 Week 9 Week 10 Week 11 Week 12 Week 13 Week 14 Week 15 Week 16 Week 17 Week 18 Week 19 Week 20 Week 21 Week 22
Daniel Baller 11 12 10 10 5 9 11 9 8 8 8 10 NA 8 11 14 11 8 3 4 1 1 1 21 0.6590 0.6290
Angus Ferrell 9 12 10 NA NA 11 10 9 11 11 8 9 10 6 8 11 NA NA 3 2 NA 1 1 17 0.6589 0.5092
Christina Neal 9 8 7 5 NA NA NA NA NA NA 12 NA 10 12 12 13 8 9 5 4 1 1 1 15 0.6517 0.4443
Harold Sampson 12 12 10 11 5 9 12 9 9 9 12 12 10 5 8 9 8 7 5 2 1 1 1 22 0.6426 0.6426
Justin Mclellan 12 12 10 7 6 11 12 7 9 8 9 10 8 10 8 9 8 12 4 3 2 1 1 22 0.6426 0.6426
Abby Wilton 9 11 NA 7 5 10 12 8 10 8 8 12 10 9 8 9 8 10 4 2 1 1 1 21 0.6160 0.5880
Michael Hoffman 11 8 13 10 4 9 11 9 4 10 9 10 9 9 11 6 NA NA 2 2 2 1 1 20 0.6098 0.5544
Bonvie Fosam 11 11 NA 9 5 7 10 8 12 4 10 10 NA 9 NA 11 NA 8 4 1 NA 1 1 17 0.6093 0.4708
Mariah Boyce 10 12 9 7 6 10 5 5 NA 7 10 8 10 7 9 13 7 11 3 1 1 1 1 21 0.5779 0.5516
Roni Brown 6 NA 10 NA 7 NA NA NA 10 NA NA NA NA 7 NA NA NA NA NA NA 2 1 1 7 0.5733 0.1824
Peter Previte 12 12 10 10 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 4 0.7097 0.1290
Brandon Des Jardins 14 12 12 10 3 NA 13 9 9 10 12 NA NA NA NA NA NA NA NA NA NA NA 0 10 0.7075 0.3216
Bradley Whitehall 6 11 12 10 9 9 11 11 NA 10 14 11 NA NA NA NA NA NA NA NA NA NA 0 11 0.7037 0.3518
Christina Shumate 14 11 12 8 8 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 5 0.6974 0.1585
Brenna Friedel 11 11 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 2 0.6875 0.0625
Adrienne Saltik NA 12 11 8 9 10 10 6 11 NA 13 8 10 10 12 NA NA NA NA NA NA NA 0 13 0.6842 0.4043
Dylan Soule 8 13 8 11 NA NA 13 NA 9 9 11 9 10 7 10 NA NA NA NA NA NA NA 0 12 0.6629 0.3616
Sean Fraser 9 12 9 9 7 NA 9 8 10 10 13 9 NA NA NA 10 NA NA NA NA NA NA 0 12 0.6534 0.3564
Elliott Clark 9 11 8 9 7 10 11 8 9 9 12 10 11 6 11 10 NA NA NA NA NA NA 0 16 0.6426 0.4673
Peter Meyers 14 13 9 7 5 11 11 5 NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 8 0.6303 0.2292
Grace Chao 10 13 9 9 7 9 NA 7 10 NA NA NA NA NA NA NA NA NA NA NA NA NA 0 8 0.6271 0.2280
Matthew Lohff 11 13 10 9 NA 9 9 6 8 9 NA NA NA 8 NA NA NA NA NA NA NA NA 0 10 0.6259 0.2845
Justin Hartung 12 11 10 9 NA 7 11 7 11 9 7 6 10 9 10 10 9 10 2 NA NA NA 0 18 0.6250 0.5114
Kraig Sheetz 10 NA 10 NA 6 NA 10 7 NA 10 NA NA NA NA NA NA NA NA NA NA NA NA 0 6 0.6163 0.1681
Aaron Johnston 12 11 10 7 8 7 10 8 NA NA NA NA NA 8 NA NA NA NA NA NA NA NA 0 9 0.6090 0.2491
Benjamin Siegel 12 11 9 8 6 8 10 NA 8 NA NA NA NA NA NA NA NA NA NA NA NA NA 0 8 0.6000 0.2182
Mary Beth Inks 11 NA 10 NA 6 NA 11 8 9 5 9 8 8 NA NA NA NA NA NA NA NA NA 0 10 0.5862 0.2665
Lucas Miller 11 9 NA 10 6 9 NA NA NA NA NA NA NA 8 NA NA NA NA NA NA NA NA 0 6 0.5824 0.1588
Elisa Sun 11 NA NA NA 5 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA 0 2 0.5333 0.0485

Season Leaderboard

Season Leaderboard (Season Percent)
Week 22
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Peter Previte 0 4 0.7097 0.1290
2 Brandon Des Jardins 2 10 0.7075 0.3216
3 Bradley Whitehall 3 11 0.7037 0.3518
4 Christina Shumate 1 5 0.6974 0.1585
5 Brenna Friedel 0 2 0.6875 0.0625
6 Adrienne Saltik 2 13 0.6842 0.4043
7 Dylan Soule 3 12 0.6629 0.3616
8 Daniel Baller 4 21 0.6590 0.6290
9 Angus Ferrell 3 17 0.6589 0.5092
10 Sean Fraser 0 12 0.6534 0.3564
11 Christina Neal 5 15 0.6517 0.4443
12 Elliott Clark 1 16 0.6426 0.4673
12 Harold Sampson 4 22 0.6426 0.6426
12 Justin Mclellan 4 22 0.6426 0.6426
15 Peter Meyers 3 8 0.6303 0.2292
16 Grace Chao 1 8 0.6271 0.2280
17 Matthew Lohff 1 10 0.6259 0.2845
18 Justin Hartung 0 18 0.6250 0.5114
19 Kraig Sheetz 0 6 0.6163 0.1681
20 Abby Wilton 2 21 0.6160 0.5880
21 Michael Hoffman 3 20 0.6098 0.5544
22 Bonvie Fosam 2 17 0.6093 0.4708
23 Aaron Johnston 0 9 0.6090 0.2491
24 Benjamin Siegel 0 8 0.6000 0.2182
25 Mary Beth Inks 0 10 0.5862 0.2665
26 Lucas Miller 0 6 0.5824 0.1588
27 Mariah Boyce 1 21 0.5779 0.5516
28 Roni Brown 2 7 0.5733 0.1824
29 Elisa Sun 0 2 0.5333 0.0485

Adjusted Season Leaderboard

Season Leaderboard (Adjusted Season Percent)
Week 22
Season Rank Name Donuts Won Weeks Picked Season Percent Adj Season Percent Season Trend
1 Harold Sampson 4 22 0.6426 0.6426
1 Justin Mclellan 4 22 0.6426 0.6426
3 Daniel Baller 4 21 0.6590 0.6290
4 Abby Wilton 2 21 0.6160 0.5880
5 Michael Hoffman 3 20 0.6098 0.5544
6 Mariah Boyce 1 21 0.5779 0.5516
7 Justin Hartung 0 18 0.6250 0.5114
8 Angus Ferrell 3 17 0.6589 0.5092
9 Bonvie Fosam 2 17 0.6093 0.4708
10 Elliott Clark 1 16 0.6426 0.4673
11 Christina Neal 5 15 0.6517 0.4443
12 Adrienne Saltik 2 13 0.6842 0.4043
13 Dylan Soule 3 12 0.6629 0.3616
14 Sean Fraser 0 12 0.6534 0.3564
15 Bradley Whitehall 3 11 0.7037 0.3518
16 Brandon Des Jardins 2 10 0.7075 0.3216
17 Matthew Lohff 1 10 0.6259 0.2845
18 Mary Beth Inks 0 10 0.5862 0.2665
19 Aaron Johnston 0 9 0.6090 0.2491
20 Peter Meyers 3 8 0.6303 0.2292
21 Grace Chao 1 8 0.6271 0.2280
22 Benjamin Siegel 0 8 0.6000 0.2182
23 Roni Brown 2 7 0.5733 0.1824
24 Kraig Sheetz 0 6 0.6163 0.1681
25 Lucas Miller 0 6 0.5824 0.1588
26 Christina Shumate 1 5 0.6974 0.1585
27 Peter Previte 0 4 0.7097 0.1290
28 Brenna Friedel 0 2 0.6875 0.0625
29 Elisa Sun 0 2 0.5333 0.0485

Data

---
title: "2025 NFL Moneyline Picks"
output: 
  flexdashboard::flex_dashboard:
    theme:
      version: 4
      bootswatch: spacelab
    orientation: rows
    vertical_layout: fill
    social: ["menu"]
    source_code: embed
    navbar:
      - { title: "Created by: Daniel Baller", icon: "fa-github", href: "https://github.com/danielpballer"  }
---


```{r setup, include=FALSE}
#    source_code: embed
options(show.error.messages = FALSE) 
library(flexdashboard)
library(tidyverse)
library(data.table)
library(formattable)
library(ggpubr)
library(ggrepel)
library(gt)
library(glue)
library(ggthemes)
library(hrbrthemes)
library(sparkline)
library(plotly)
library(htmlwidgets)
#library(mdthemes)
library(ggtext)
library(ggnewscale)
library(DT)
source("./Functions/functions2.R")

thematic::thematic_rmd(font = "auto")

# Use line 211 if you need to hard code any losses for a week
```

```{r Reading in our picks files, include=FALSE}
current_week = 22 #Set what week it is
week_1 = read_csv("./CSV_Data_Files/2025 NFL Week 1.csv")%>% 
  mutate(Name = str_to_title(Name))
week_2 = read_csv("./CSV_Data_Files/2025 NFL Week 2.csv")%>% 
 mutate(Name = str_to_title(Name))
week_3 = read_csv("./CSV_Data_Files/2025 NFL Week 3.csv")%>% 
 mutate(Name = str_to_title(Name))
week_4 = read_csv("./CSV_Data_Files/2025 NFL Week 4.csv")%>%
 mutate(Name = str_to_title(Name))
week_5 = read_csv("./CSV_Data_Files/2025 NFL Week 5.csv")%>% 
 mutate(Name = str_to_title(Name))
week_6 = read_csv("./CSV_Data_Files/2025 NFL Week 6.csv")%>% 
 mutate(Name = str_to_title(Name))
week_7 = read_csv("./CSV_Data_Files/2025 NFL Week 7.csv")%>% 
 mutate(Name = str_to_title(Name))
week_8 = read_csv("./CSV_Data_Files/2025 NFL Week 8.csv")%>% 
 mutate(Name = str_to_title(Name))
week_9 = read_csv("./CSV_Data_Files/2025 NFL Week 9.csv")%>% 
 mutate(Name = str_to_title(Name))
week_10 = read_csv("./CSV_Data_Files/2025 NFL Week 10.csv")%>% 
 mutate(Name = str_to_title(Name))
week_11 = read_csv("./CSV_Data_Files/2025 NFL Week 11.csv")%>% 
 mutate(Name = str_to_title(Name))
week_12 = read_csv("./CSV_Data_Files/2025 NFL Week 12.csv")%>% 
 mutate(Name = str_to_title(Name))
week_13 = read_csv("./CSV_Data_Files/2025 NFL Week 13.csv")%>% 
 mutate(Name = str_to_title(Name))
week_14 = read_csv("./CSV_Data_Files/2025 NFL Week 14.csv")%>% 
 mutate(Name = str_to_title(Name))
week_15 = read_csv("./CSV_Data_Files/2025 NFL Week 15.csv")%>% 
 mutate(Name = str_to_title(Name))
week_16 = read_csv("./CSV_Data_Files/2025 NFL Week 16.csv")%>% 
 mutate(Name = str_to_title(Name))
week_17 = read_csv("./CSV_Data_Files/2025 NFL Week 17.csv")%>% 
 mutate(Name = str_to_title(Name))
week_18 = read_csv("./CSV_Data_Files/2025 NFL Week 18.csv")%>% 
 mutate(Name = str_to_title(Name))
week_19 = read_csv("./CSV_Data_Files/2025 NFL Wild Card.csv")%>% 
 mutate(Name = str_to_title(Name))
week_20 = read_csv("./CSV_Data_Files/2025 NFL Divisional Round.csv")%>% 
 mutate(Name = str_to_title(Name))
week_21 = read_csv("./CSV_Data_Files/2025 NFL Conference Round.csv")%>% 
 mutate(Name = str_to_title(Name))
week_22 = read_csv("./CSV_Data_Files/2025 NFL Super Bowl.csv")%>% 
 mutate(Name = str_to_title(Name))

#reading in scores
Scores = read_csv(glue::glue("./CSV_Data_Files/NFL_Scores_{current_week}.csv")) 

#reading in CBS Prediction Records
cbs = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_{current_week}.csv")) %>% 
  mutate(Percent = round(Percent,4))
cbs_season = read_csv(glue::glue("./CSV_Data_Files/CBS_Experts_Season_{current_week}.csv"))

#reading in ESPN Prediction Records
espn = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))
espn_season = read_csv(glue::glue("./CSV_Data_Files/ESPN_Experts_Season_{current_week}.csv"))%>% 
  mutate(Percent = round(Percent,4))

#Odds not working for the 2024 season.  Need to fix scrape code for next year.
#Reading in the moneyline odds for each team and cleaning the team names
# odds_wk1 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_1.csv"))
# odds_wk2 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_2.csv"))
# odds_wk3 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_3.csv"))
# odds_wk4 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_4.csv"))
# odds_wk5 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_5.csv"))
# odds_wk6 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_6.csv"))
# odds_wk7 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_7.csv"))
# odds_wk8 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_8.csv"))
# odds_wk9 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_9.csv"))
# odds_wk10 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_10.csv"))
# odds_wk11 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_11.csv"))
# odds_wk12 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_12.csv"))
# odds_wk13 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_13.csv"))
# odds_wk14 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_14.csv"))
# odds_wk15 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_15.csv"))
# odds_wk16 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_16.csv"))
# odds_wk17 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_17.csv"))
# odds_wk18 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_18.csv"))
# odds_wk19 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_19.csv"))
# odds_wk20 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_20.csv"))
# odds_wk21 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_21.csv"))
# odds_wk22 = read_csv(glue::glue("./CSV_Data_Files/Moneyline_Odds_22.csv"))

####################UPDATE THESE###############################
inst.picks = list(week_1, week_2, week_3, week_4, week_5, week_6, week_7, week_8, week_9, week_10, week_11, week_12, week_13, week_14, week_15, week_16, week_17, week_18, week_19, week_20, week_21, week_22) #add in the additional weeks
#odds = rbind(odds_wk1, odds_wk2, odds_wk3, odds_wk4, odds_wk5, odds_wk6, odds_wk7, odds_wk8,
#              odds_wk9, odds_wk10, odds_wk11, odds_wk12) #add in the additional weeks
####################END OF UPDATE##############################) #

weeks = as.list(seq(1:current_week)) #creating a list of each week number
```

```{r read in scores clean data, include=FALSE}
#Cleaning Odds Data
# cl_odds = odds_cleaning(odds)

#Cleaning scores data
Scores = cleaning2(Scores)

#creating a list of winners for each week
winners = map(weeks, weekly_winners)

#creating a vector of this weeks winners
this_week = pull(winners[[length(winners)]])  

#Getting the number of games for each week
weekly_number_of_games = map_dbl(weeks, week_number_games)
```

```{r Group Predictions, include=FALSE}
#Creating the list of everyones predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Adding who won to the predictions
with_winners = map2(pred_table, winners, adding_winners)

#Creating results for each week.
results = map2(with_winners,weekly_number_of_games, results_fn)
```


```{r Displaying Group Results, echo=FALSE}
#Displaying the group results

inst_group_table = results[[length(results)]] %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    #subtitle = md(glue("Week {length(results)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="No"
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Correct),
      rows = Correct =="Yes"
    )) %>% 
  tab_options(
    data_row.padding = px(3),
    container.height = "100%"
   )
```

```{r Weekly and season Group Results, include=FALSE}
# Printing the weekly and season win percentage     

#how many games correct, incorrect, and not picked each week
weekly_group_correct = map(results, weekly_group_correct_fn)  

#how many games were picked each week
weekly_games_picked = map2(weekly_group_correct, weekly_number_of_games, weekly_games_picked_fn)

#Calculating the number of correct picks for each week
weekly_group_correct_picks = map(weekly_group_correct, weekly_group_correct_picks_fn)

# Code to manually hard code in week where we get 0 games correct
# ##### Remove this line before next season 
#weekly_group_correct_picks[[21]]=0

#Calculating weekly win percentage
weekly_win_percentage = map2(weekly_group_correct_picks, weekly_games_picked, weekly_win_percentage_fn)

#Calculating season win percentage
season_win_percentage = round(sum(unlist(weekly_group_correct_picks))/sum(unlist(weekly_games_picked)),4)

#Calculating number of games picked this season
season_games = sum(unlist(weekly_games_picked))

#calculating season wins
season_wins = sum(unlist(weekly_group_correct_picks))

#calculating the number of people who picked this week
Total = dim(inst.picks[[length(weeks)]])[1]
```

```{r plotting group results, include=FALSE}
#Previous Weeks
group_season_for_plotting = unlist(weekly_win_percentage) %>% as.data.frame() %>% 
  rename(`Win Percentage` = ".") %>% 
  add_column(Week = unlist(weeks))
```

```{r Plotting the group results, echo=FALSE}
inst_group_season_plot = group_season_for_plotting %>% 
ggplot(aes(x = as.factor(Week), y = `Win Percentage`))+
  geom_point()+
  geom_path(aes(x = Week))+
  ylim(c(0, 1)) +
  xlab("NFL Week") + 
  ylab("Correct Percentage")+
  ggtitle("Weekly Group Correct Percentage")+
  theme_classic()+
  theme(plot.title = element_text(hjust = 0.5, size = 18))
```

```{r beating cbs week, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_weekly_percent = map(weeks, cbs_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat = map2(cbs_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_total = map(cbs_weekly_percent, experts_tot)
```

```{r beating cbs season, include=FALSE}
#Creating a list of correct percentages for each week.
cbs_season_percent = map(weeks, cbs_season_percent)

#Creating a list of how many cbs experts we beat each week.
cbs_experts_beat_season = map2(cbs_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
cbs_experts_season_total = map(cbs_season_percent, experts_tot)
```

```{r beating ESPN week, include=FALSE}
#Creating a list of correct percentages for each week.
espn_weekly_percent = map(weeks, espn_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat = map2(espn_weekly_percent, weekly_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_total = map(espn_weekly_percent, experts_tot)
```

```{r beating ESPN season, include=FALSE}
#Creating a list of correct percentages for each week.
espn_season_percent = map(weeks, espn_season_percent)

#Creating a list of how many cbs experts we beat each week.
espn_experts_beat_season = map2(espn_season_percent, season_win_percentage, experts_beat)

#Creating a list of how many cbs experts picked each week.  
espn_experts_season_total = map(espn_season_percent, experts_tot)
```

```{r individual results, include=FALSE}
#Creating a list of individual results for each week.
weekly_indiv = pmap(list(inst.picks, winners, weeks), indiv_weekly_pred)

#Combining each week into one dataframe and calculating percentage Correct for this week.  
full_season = weekly_indiv %>% reduce(full_join, by = "Name") %>% 
  mutate(Percent = round(pull(.[,ncol(.)]/weekly_number_of_games[[length(weekly_number_of_games)]]),4)) 

#Creating a dataframe with only the weekly picks
a = full_season %>% select(starts_with("Week"))

#Creating a vector of how many weeks each person picked over the season
tot_week = NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = ifelse(is.na(a[i,j])==T,0,1)
    tot_week[i] = sum(help)
  }
}

#Creating a vector of how many games each person picked over the season
tot_picks= NULL
help = NULL
for (i in 1:dim(a)[1]){
  for(j in 1:length(a)){
    help[j] = unlist(weekly_games_picked)[j]*ifelse(is.na(a[i,j])==T,0,1)
    tot_picks[i] = sum(help)
  }
}

#Creatign a vector of how many games each person picked correct over the season
tot_correct = NULL
help = NULL
for (i in 1:dim(a)[1]){
  tot_correct[i] = sum(a[i,], na.rm = T)
}

#adding how many weeks each person picked, season correct percentage, and adjusted season percentag to the data frame and sorting the data
indiv_disp = full_season %>% add_column(`Weeks Picked` = tot_week) %>%
  add_column(tot_correct)%>%
  add_column(tot_picks)%>%
  mutate(`Season Percent` = round(tot_correct/tot_picks,4))%>%
  mutate(`Adj Season Percent` = round(`Season Percent`*(tot_week/length(a)),4)) %>%
  select(-tot_correct, -tot_picks) %>%
  arrange(desc(Percent), desc(`Season Percent`)) %>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent))
```


```{r individual percentages, include=FALSE}
#Calculating individual percentages for each week.
weekly_indiv_percent = map2(weekly_indiv, as.list(weekly_number_of_games), indiv_percent) %>% reduce(full_join, by = "Name")

weekly_indiv_percent_plot = weekly_indiv_percent %>% 
  pivot_longer(cols = starts_with("Week"), names_to = "Week", values_to = "Percent")%>%
  mutate(Percent = ifelse(is.na(Percent)==T, 0, Percent)) %>% 
  mutate(Week = as.factor(Week))

levels = NULL
for(i in 1:length(weeks)){
  levels[i] = glue("Week {i}")  
}

weekly_indiv_percent_plot = weekly_indiv_percent_plot %>%
  mutate(Week = factor(Week, levels))
```

```{r sparklines, include=FALSE}
#adding sparklines
plot_group = function(name, df){
  plot_object = 
    ggplot(data = df,
           aes(x = as.factor(Week), y=Percent, group = 1))+
    geom_path(size = 7)+
    scale_y_continuous(limits = c(0,1))+
    theme_void()+
    theme(legend.position = "none")
  return(plot_object)
}

sparklines = 
  weekly_indiv_percent_plot %>% 
  group_by(Name) %>% 
  nest() %>% 
  mutate(plot = map2(Name, data, plot_group)) %>% 
  select(-data)
  
indiv_disp_2 = indiv_disp %>% 
  inner_join(sparklines, by = "Name") %>% 
  mutate(`Season Trend` = NA)
```

```{r Printing Individual Table2, echo=FALSE}
# Printing the individual Table
indiv_table = indiv_disp_2 %>% gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Individual Results"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(Percent),
      rows = Percent>.5
    )) %>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(indiv_disp_2$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(c(plot))

indiv_winners = indiv_disp_2 %>% filter(Percent == max(Percent)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season = indiv_disp_2 %>% filter(`Season Percent` == max(`Season Percent`)) %>% select(Name) %>% pull() %>% paste(collapse = ", ")
indiv_season_adj = indiv_disp_2 %>% filter(`Adj Season Percent` == max(`Adj Season Percent`)) %>% select(Name) %>% pull()%>% paste(collapse = ", ")
```

```{r Printing Season Leaderboard, echo=FALSE}
# Printing the Season Leaderboard
  
season_leaderboard_disp = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`) 
  
season_leaderboard = season_leaderboard_disp %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(season_leaderboard_disp$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```

```{r Printing Adj Season Leaderboard, echo=FALSE}
# Printing the Adj Season Leaderboard
  
adj_season_leaderboard_disp = indiv_disp_2 %>% select(Name, starts_with("Week ")) %>% 
  pivot_longer(starts_with("Week"),names_to = "Week", values_to = "Correct") %>% 
  group_by(Week) %>% 
  mutate(Correct = case_when(is.na(Correct)==T~0, 
                             TRUE~Correct)) %>% 
  mutate(Donut = case_when(Correct==max(Correct)~1,
                           TRUE~0))  %>% 
  ungroup() %>% 
  group_by(Name) %>% 
  summarise(`Donuts Won` = sum(Donut)) %>% 
  #mutate(`Donuts Won` = strrep("award,", Donuts)) %>% 
  right_join(.,indiv_disp_2) %>% 
  select(-starts_with("Week "), -Percent) %>% 
  mutate(`Season Rank` = min_rank(desc(`Adj Season Percent`)),.before = Name) %>% 
  arrange(`Season Rank`)

adj_season_leaderboard = adj_season_leaderboard_disp %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("Season Leaderboard (Adjusted Season Percent)"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
  # fmt_icon(
  #   columns = `Donuts Won`,
  #   fill_color = "gold",
  # ) %>%
  tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Season Percent`),
      rows = `Season Percent`>.5
    ))%>% 
     tab_style(
    style = cell_text(color = "red", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`<.5
    )) %>% 
   tab_style(
    style = cell_text(color = "green", weight = "bold"),
    locations = cells_body(
      columns = c(`Adj Season Percent`),
      rows = `Adj Season Percent`>.5
    )) %>% 
  tab_options(
    container.width = pct(100),
    data_row.padding = px(1),
    container.height = "100%"
   ) %>%
    tab_spanner(
    label = "Weekly # Correct",
    columns = starts_with(c("Week "))
  ) %>% 
  text_transform(
    locations = cells_body(c(`Season Trend`)),
    fn = function(x){
      map(adj_season_leaderboard_disp$plot, ggplot_image, height = px(30), aspect_ratio = 4)
                 }) %>%
  cols_hide(columns = c(plot))
```


```{r instructor formattable, echo=FALSE}
improvement_formatter <- 
  formatter("span", 
            style = x ~ formattable::style(
              font.weight = "bold", 
              color = ifelse(x > .5, "green", ifelse(x < .5, "red", "black"))),
             x ~ icontext(ifelse(x == max(x), "star", ""), x))

indiv_disp_3 = indiv_disp_2 %>% select(-plot)
indiv_disp_3$`Season Trend` = apply(indiv_disp_3[,2:(1+length(weeks))], 1, FUN = function(x) as.character(htmltools::as.tags(sparkline(as.numeric(x), type = "line", chartRangeMin = 0, chartRangeMax = 1, fillColor = "white"))))

indiv_table_2 = as.htmlwidget(formattable(indiv_disp_3, 
                                align = c("l", rep("c", NROW(indiv_disp_3)-1)),
              list(`Season Percent` = color_bar("#FA614B"),
              `Season Percent`= improvement_formatter,
              `Adj Season Percent`= improvement_formatter)))
              
indiv_table_2$dependencies = c(indiv_table_2$dependencies, htmlwidgets:::widget_dependencies("sparkline", "sparkline"))
```

```{r Plotting individual results over the season2, eval=FALSE, include=FALSE, out.width="100%"}
#Creating the individual plot.  
inst_indiv_plots = weekly_indiv_percent_plot %>% 
  ggplot(aes(x = factor(Week), y = Percent, color = Name))+
  geom_point()+
  geom_path(aes(x = as.factor(Week), y = Percent, color = Name, 
                group = Name))+
  ylim(c(0, 1)) +
  labs(x = "NFL Week", 
       y = "Correct Percentage", 
       title = "Weekly Individual Correct Percentage")+
  facet_wrap(~Name)+
  theme_classic()+
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, size = 18),
        axis.text.x=element_text(angle =45, vjust = 1, hjust = 1))
```

```{r data for data page}
inst.data = map2(inst.picks, weeks, disp_data) %>% bind_rows()
```


```{r fivethirtyeight}
inst_538 = map(results, five38) %>% unlist() %>% sum()
```

```{r pregame, eval=FALSE, include=FALSE}
#Predictions for the week

#Creating the list of group predictions each week.
games = map(inst.picks, games_fn)

#Creating the prediction table.  
pred_table = map(games, pred_table_fn)

#Printing table of instructor predictions
pred_table[[length(pred_table)]] %>% mutate(Game = row_number()) %>% 
  rename(`Votes For` = votes_for, `Votes Against` = votes_against) %>% 
  gt() %>% 
  cols_align(
    align = "center") %>% 
   tab_header(
    title = md("This Week's Predictions"),
    subtitle = md(glue("Week {length(weeks)}"))
    ) %>% 
   tab_options(
    data_row.padding = px(3)
   )
```

Group Predictions
==========================================================================

Sidebar {.sidebar} 
-------------------------------------
#### CBS Sports

<font size="4">

This week we beat or tied `r cbs_experts_beat[[length(weeks)]]` of `r cbs_experts_total[[length(weeks)]]` CBS Sports' Experts.

For the season we are currently beating or tied with `r cbs_experts_beat_season[[length(weeks)]]` of `r cbs_experts_season_total[[length(weeks)]]` CBS Sports' Experts.
 
 </font>


#### ESPN

<font size="4">

We also beat or tied `r espn_experts_beat[[length(weeks)]]` of `r espn_experts_total[[length(weeks)]]` ESPN Experts.
 
For the season we are currently beating or tied with `r espn_experts_beat_season[[length(weeks)]]` of `r espn_experts_season_total[[length(weeks)]]` ESPN Experts.

</font>

Row
--------------------------------------

### Win percentage for the week

```{r}
inst_rate <- weekly_win_percentage[[length(weekly_win_percentage)]]*100
gauge(inst_rate, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Season Win Percentage

```{r}
inst_season <- season_win_percentage*100
gauge(inst_season, min = 0, max = 100, symbol = '%', gaugeSectors(
  success = c(55, 100), warning = c(40, 54), danger = c(0, 39)
))
```

### Games Correct
```{r}
valueBox(value = season_wins,icon = "fa-trophy",caption = "Correct Games this Season")
```

### Games Picked
```{r}
valueBox(value = season_games,icon = "fa-clipboard-list",caption = "Games Picked this Season")
```

### Number of predictions
```{r}
valueBox(value = Total,icon = "fa-users",caption = "Predictions this week")
```

Row
--------------------------------------

### 

```{r}
inst_group_table
```

### 

```{r}
ggplotly(inst_group_season_plot) %>% 
  layout(title = list(y = .93, xref = "plot"),
         margin = list(t = 40))
```

Individual Predictions
==========================================================================


Sidebar {.sidebar} 
-------------------------------------

#### Best Picks of the Week.

<font size="4">

 `r indiv_winners`
 
 </font>
 
#### Best Season Correct Percentage
<font size="4">

`r indiv_season`
 
 </font>

#### Best Adjusted Season Correct Percentage
<font size="4">

`r indiv_season_adj`

 * Adjusted season percentage accounts for the number of weeks picked.
 
 </font>

row {.tabset}
--------------------------------------

### Individual Table
```{r, results='asis', error=FALSE}
indiv_table
```

<!--
### Individual Table2

```{r, out.height="100%"}
indiv_table_2
```

-->

<!--

### Individual Plots
```{r, out.width="100%"}
#ggplotly(inst_indiv_plots)
```

-->

### Season Leaderboard
```{r, results='asis', error=FALSE}
season_leaderboard
```

### Adjusted Season Leaderboard
```{r, results='asis', error=FALSE}
adj_season_leaderboard
```

Data
==========================================================================

```{r}
datatable(
  inst.data, extensions = 'Buttons', options = list(
    dom = 'Blfrtip',
    buttons = c('copy', 'csv', 'excel', 'pdf', 'print'),
    lengthMenue = list( c(10, 25, 50, 100, -1), c(10, 25, 50, 100, "All") )
  )
)
```